home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / clinic / MainU.pas < prev    next >
Pascal/Delphi Source File  |  1997-12-08  |  3KB  |  112 lines
  1. unit MainU;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Exit1: TMenuItem;
  14.     Help1: TMenuItem;
  15.     NewItem1: TMenuItem;
  16.     NewItem2: TMenuItem;
  17.     NewItem3: TMenuItem;
  18.     procedure NewItem1Click(Sender: TObject);
  19.     procedure NewItem2Click(Sender: TObject);
  20.     procedure NewItem3Click(Sender: TObject);
  21.   private
  22.     { Private declarations }
  23.   public
  24.     { Public declarations }
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. implementation
  31.  
  32. {$R *.DFM}
  33.  
  34. procedure TForm1.NewItem1Click(Sender: TObject);
  35. begin
  36.   { This loses the maximised MDI child system buttons }
  37.   Menu.Items.Insert(1, NewItem('New 1', 0, False, True, nil, 0, ''));
  38. end;
  39.  
  40. procedure TForm1.NewItem2Click(Sender: TObject);
  41. var
  42.   Flag: Boolean;
  43. begin
  44.   Flag := ActiveMDIChild.WindowState = wsMaximized;
  45.   if Flag then
  46.   begin
  47.     { Causes some flicker outside the app }
  48.     LockWindowUpdate(Handle);
  49.     ActiveMDIChild.WindowState := wsNormal;
  50.   end;
  51.   try
  52.     Menu.Items.Insert(1, NewItem('New 2', 0, False, True, nil, 0, ''))
  53.   finally
  54.     if Flag then
  55.     begin
  56.       ActiveMDIChild.WindowState := wsMaximized;
  57.       LockWindowUpdate(0)
  58.     end
  59.   end
  60. end;
  61.  
  62. procedure TForm1.NewItem3Click(Sender: TObject);
  63. {$ifdef Win32}
  64. var
  65.   Flag, Animation: Boolean;
  66.  
  67.   function GetAnimation: Boolean;
  68.   var
  69.     Info: TAnimationInfo;
  70.   begin
  71.     Info.cbSize := SizeOf(TAnimationInfo);
  72.     if SystemParametersInfo(SPI_GETANIMATION, SizeOf(Info), @Info, 0) then
  73.       Result := Info.iMinAnimate <> 0 else
  74.       Result := False;
  75.   end;
  76.  
  77.   procedure SetAnimation(Value: Boolean);
  78.   var
  79.     Info: TAnimationInfo;
  80.   begin
  81.     Info.cbSize := SizeOf(TAnimationInfo);
  82.     BOOL(Info.iMinAnimate) := Value;
  83.     SystemParametersInfo(SPI_SETANIMATION, SizeOf(Info), @Info, 0);
  84.   end;
  85.  
  86. {$endif}
  87. begin
  88. {$ifdef Win32}
  89.   Flag := ActiveMDIChild.WindowState = wsMaximized;
  90.   Animation := GetAnimation;
  91.   if Flag then
  92.   begin
  93.     { Causes some flicker inside the app }
  94.     if Animation then SetAnimation(False);
  95.     ActiveMDIChild.WindowState := wsNormal
  96.   end;
  97.   try
  98.     Menu.Items.Insert(1, NewItem('New 3', 0, False, True, nil, 0, ''))
  99.   finally
  100.     if Flag then
  101.     begin
  102.       ActiveMDIChild.WindowState := wsMaximized;
  103.       if Animation then SetAnimation(True)
  104.     end
  105.   end
  106. {$else}
  107.   ShowMessage('This option is Win32 only')
  108. {$endif}
  109. end;
  110.  
  111. end.
  112.